
           EJECT
       Y100-REPEAT-PROGRAM.

           MOVE 'Y100'      TO CA-PARAGRAPH-NBR.

           MOVE PROGRAM-NAME TO CA-CURRENT-PGM.
           MOVE TXN-ID       TO W0001-TXN-ID.
           MOVE TXN-ID       TO CA-CURRENT-TXN.

           EXEC CICS HANDLE CONDITION
                ERROR   (Z300-TXN-ID-ERROR)
           END-EXEC.

           EXEC CICS RETURN
                TRANSID  (W0001-TXN-ID)
                COMMAREA (WS-COMMAREA)
                LENGTH   (LENGTH OF WS-COMMAREA)
           END-EXEC.

           EJECT
       Y200-XCTL-TO-PROGRAM.

           MOVE 'Y200'      TO CA-PARAGRAPH-NBR.

           EXEC CICS HANDLE CONDITION
                ERROR   (Z400-XCTL-ERROR)
           END-EXEC.

           EXEC CICS XCTL
                PROGRAM  (W0001-XCTL-PGM-ID)
                COMMAREA (WS-COMMAREA)
                LENGTH   (LENGTH OF WS-COMMAREA)
           END-EXEC.

           EJECT
       Y300-LINK-TO-PROGRAM.

           MOVE 'Y300'      TO CA-PARAGRAPH-NBR.

           EXEC CICS LINK
                PROGRAM  (W0001-LINK-PGM-ID)
                COMMAREA (W0001-LINK-CA)
                LENGTH   (LENGTH OF W0001-LINK-CA)
           END-EXEC.

           EJECT
       Y400-RETURN-TO-CICS.

           MOVE 'Y400'      TO CA-PARAGRAPH-NBR.

           EXEC CICS SEND
                FROM   (W9999-END-MESSAGE)
                LENGTH (LENGTH OF W9999-END-MESSAGE)
                ERASE
           END-EXEC.

           EXEC CICS RETURN
           END-EXEC.

           GOBACK.

           EJECT

       Y500-SYNCPOINT.

           MOVE 'Y500'      TO CA-PARAGRAPH-NBR.

           EXEC CICS SYNCPOINT
           END-EXEC.

           EJECT
       Y600-ROLLBACK.

           MOVE 'Y600'      TO CA-PARAGRAPH-NBR.

           EXEC CICS SYNCPOINT ROLLBACK
           END-EXEC.

           EJECT
       Y600-START-TRANSACTION.

           MOVE 'Y600'      TO CA-PARAGRAPH-NBR.

           EXEC CICS HANDLE CONDITION
                ERROR (Z300-TXN-ID-ERROR)
           END-EXEC.

           EXEC CICS START
                TRANSID (W0001-TXN-ID)
                TERMID  (EIBTRMID)
           END-EXEC.

           EXEC CICS RETURN
           END-EXEC.

           EJECT
       Y700-START-TRANSACTION.

           MOVE 'Y700'      TO CA-PARAGRAPH-NBR.

           EXEC CICS HANDLE CONDITION
                ERROR (Z300-TXN-ID-ERROR)
           END-EXEC.

           EXEC CICS START
                TRANSID (W0001-TXN-ID)
                TERMID  (EIBTRMID)
           END-EXEC.

           EXEC CICS RETURN
                TRANSID  (W0001-TXN-ID)
                COMMAREA (WS-COMMAREA)
                LENGTH   (LENGTH OF WS-COMMAREA)
           END-EXEC.


           EJECT
       Z100-MAPFAIL.

           MOVE 'Z100'      TO CA-PARAGRAPH-NBR.

           PERFORM Y400-RETURN-TO-CICS.

           EJECT
       Z200-NO-MAPFAIL.

           MOVE 'Z200'      TO CA-PARAGRAPH-NBR.

           PERFORM Y400-RETURN-TO-CICS.

           EJECT
       Z300-TXN-ID-ERROR.

           MOVE 'Z300'      TO CA-PARAGRAPH-NBR.

      *    PERFORM Y400-RETURN-TO-CICS.

           MOVE 'Z300-TXN ' TO W9999-BAD-PARA.
           MOVE W9999-BAD-MESSAGE TO M-MSG-24I.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.

           EJECT
       Z400-XCTL-ERROR.

           MOVE 'Z400'      TO CA-PARAGRAPH-NBR.

           MOVE 'Z400-XCTL' TO W9999-BAD-PARA.
           MOVE W9999-BAD-MESSAGE TO M-MSG-24I.

           PERFORM A200-DISPLAY-SCREEN.

           PERFORM Y100-REPEAT-PROGRAM.
